home *** CD-ROM | disk | FTP | other *** search
/ Merciful 5 / Merciful - Disc 5.iso / software / p / pcqpascalv1.2d.lha / Examples2 / cal / easter.p < prev    next >
Text File  |  1997-05-06  |  1KB  |  67 lines
  1. Program easter;
  2.  
  3. {
  4.     easter v1.0
  5.     © 1995 by Andreas Tetzl
  6.     FREEWARE
  7. }
  8.  
  9. {$I "Include:Utils/Parameters.i"}
  10. {$I "Include:Utils/StringLib.i"}
  11. {$I "Include:DOS/DOS.i"}
  12.  
  13. const version = "$VER: easter v1.0 (3-Nov-95) by Andreas Tetzl";
  14.  
  15. VAR i,a,b,c,d,e,m,n : Integer;
  16.     param : String;
  17.     year, month, day : Integer;
  18.  
  19.  
  20. BEGIN
  21.   param:=AllocString(50);
  22.   GetParam(1,param);
  23.   if (StrEq(param,"?")) or (StrEq(param,"")) then
  24.    BEGIN
  25.     Writeln("YEAR/N");
  26.     Exit(20);
  27.    END;
  28.  
  29.   i:=StrToLong(param,adr(year));
  30.   if (year<1583) or (year>2299) then
  31.    BEGIN
  32.     Writeln("only years between 1583 and 2299 allowed");
  33.     Exit(20);
  34.    END;
  35.  
  36.   Case year of
  37.     1583..1699 : BEGIN m:=22; n:=2; END;
  38.     1700..1799 : BEGIN m:=23; n:=3; END;
  39.     1800..1899 : BEGIN m:=23; n:=4; END;
  40.     1900..2099 : BEGIN m:=24; n:=5; END;
  41.     2100..2199 : BEGIN m:=24; n:=6; END;
  42.     2200..2299 : BEGIN m:=25; n:=0; END;
  43.   end;
  44.  
  45.   a:=year mod 19;
  46.   b:=year mod 4;
  47.   c:=year mod 7;
  48.   d:=(19*a+m) mod 30;
  49.   e:=(2*b+4*c+6*d+n) mod 7;
  50.  
  51.   day:=22+d+e;
  52.   if day<=31 then
  53.    month:=3
  54.   else
  55.    BEGIN
  56.     month:=4;
  57.     day:=d+e-9;
  58.    END;
  59.  
  60.   if (month=4) and (day=26) then day:=19;
  61.   if (month=4) and (day=25) and (d=28) and (e=6) and (a>10) then day:=18;
  62.  
  63.   Write(year,"-");
  64.   if month=3 then Write("Mar") else Write("Apr");
  65.   Writeln("-",day);
  66. END.
  67.